home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tpio24.zip
/
DATEDEMO.INC
< prev
next >
Wrap
Text File
|
1993-01-04
|
6KB
|
171 lines
{ File = DATEDEMO.INC -- Include file for IO21DEMO.PAS -- 10/9/86 }
procedure date_demo ;
{ demonstrates the things you can do with dates }
const
null_jul : juldate = (yr:0 ; day:0) ;
blanks : string[10] = ' ' ;
var
date1,
date2,
temp1,
temp2 : date ;
workjul : juldate ;
juldtst : juldatestring ;
dtst : datestring ;
fds : fulldatestring ;
diff : string[7] ;
n : integer ;
prevfld : integer ;
{ ==================== }
procedure display_diff ;
var
n : integer ;
begin
if equal_date (date1,null_date)
or equal_date (date2,null_date) then
for n := 20 to 21 do
clrline (16,n)
else if equal_date(date1,date2) then
begin
write_str ('The dates are equal',16,20) ;
write ('':20) ;
clrline (16,21)
end
else
begin
write_date (date1,16,20) ;
if greater_date(date1,date2) = 1 then
begin
write (' is later than ') ;
temp1 := date2 ;
temp2 := date1
end
else
begin
write (' is earlier than ') ;
temp1 := date1 ;
temp2 := date2
end ;
dtst := mk_dt_st(date2) ;
write (dtst) ;
write ('':20) ;
write_str ('There are ',16,21) ;
str(date_diff(temp1,temp2):7:0,diff) ;
diff := purgech(diff,' ') ;
write (diff,' days (about ') ;
write (month_diff(temp1,temp2)) ;
write (' months) between the two dates.') ;
write ('':10)
end
end ;
{ ==================== }
begin { proc date_demo }
clrscr ;
write_str('Enter two dates, press ESC to quit.',16,1) ;
write_str('DATE 1 DATE 2',32,3) ;
write_str('------ ------',32,4) ;
write_str('==> ==>',26,6) ;
write_str('Julian date:',17,10) ;
write_str('Next day:',20,12) ;
write_str('Previous day:',16,14) ;
write_str('Leap year?',19,16) ;
write_str('=============================================',16,18) ;
date1 := null_date ;
date2 := null_date ;
fld := 1 ;
repeat
case fld of
1: begin
prevfld := 1 ;
read_date (date1,30,6) ;
if (date1.yr > 0) and (date1.yr < 1563) then
begin
show_msg ('CAN''T HANDLE YEAR LESS THAN 1563') ;
date1.mo := 0 ; date1.dy := 0 ; date1.yr := 0 ;
write_date (date1,30,6) ;
fld := 1
end ;
if not (equal_date(date1,null_date)) then
begin
fds := build_full_date_str (date1) ;
write_str (fds,16,8) ;
greg_to_jul (date1,workjul) ;
juldtst := mk_jul_dt_st (workjul) ;
write_str (juldtst,32,10) ;
temp1 := date1 ;
next_day (temp1) ;
write_date (temp1,30,12) ;
temp1 := date1 ;
prev_day (temp1) ;
write_date (temp1,30,14) ;
write_bool (leapyear(date1.yr),32,16) ;
end
else
begin
gotoxy(16,8) ; write('':fdslen) ;
for n := 8 to 16 do
write_str (blanks,30,n)
end ;
display_diff
end ; { 1 }
2: begin
prevfld := 2 ;
read_date (date2,51,6) ;
if (date2.yr > 0) and (date2.yr < 1563) then
begin
show_msg ('CAN''T HANDLE YEAR LESS THAN 1563') ;
date2.mo := 0 ; date2.dy := 0 ; date2.yr := 0 ;
write_date (date2,51,6) ;
fld := 2
end ;
if not (equal_date(date2,null_date)) then
begin
fds := build_full_date_str (date2) ;
write_str (fds,47,8) ;
greg_to_jul (date2,workjul) ;
juldtst := mk_jul_dt_st (workjul) ;
write_str (juldtst,53,10) ;
temp1 := date2 ;
next_day (temp1) ;
write_date (temp1,51,12) ;
temp1 := date2 ;
prev_day (temp1) ;
write_date (temp1,51,14) ;
write_bool (leapyear(date2.yr),53,16) ;
end
else
begin
gotoxy (47,8) ; write ('':fdslen) ;
for n := 10 to 16 do
write_str (blanks,51,n)
end;
display_diff
end ; { 2 }
3: begin
prevfld := 3 ;
pause
end
end ; { case }
if fld < 1 then { can't go back from 1 }
fld := 1
else if (fld > 3) and (fld < maxint) then
begin
if prevfld = 3 then
fld := 1 { back to beginning from 3 }
else
fld := 3 { trap next_page }
end
until fld = maxint ;
fld := 1 { reset FLD for calling proc }
end ; { proc date_demo }
{ ------ EOF DATEDEMO.INC ------------------------------------ }